home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d27
/
pgmmenu.arc
/
CRC1234.CLP
< prev
next >
Wrap
Text File
|
1991-12-04
|
5KB
|
99 lines
CRC1234: PGM PARM(&USER)
/* Program - CRC1234 */
/* CPP for command - PGMMNUDFT */
/* Written - 04/12/84 */
/* Author - R. Cozzi, Jr. */
/* Revised - 10/21/85 - 12/30/85 - 02/04/86 */
/* - 02/27/86 */
/* Programmer Menu user's defaults maintenance */
DCL &USER *CHAR 20 /* User ID for defaults */
DCL &CF01 *LGL 01 /* CMD 1 key pressed */
DCL &PGMDFT *CHAR 2000 /* Menu default work var */
DCL &MSGID *CHAR 7 /* Message ID */
DCL &MSGDTA *CHAR 132 /* Message data */
DCL &MSG *CHAR 80 /* Message from RPG PGM */
DCL &MSGCNT *DEC 3 /* Number of messages sent */
DCL &MAXMSG *DEC 3 10 /* Message limit */
DCL &LIBL *CHAR 275 /* Library list */
DCL &NEW *LGL 1 '0' /* New user flag */
MONMSG MSGID(CPF0000) EXEC(GOTO RCVMSG)
IF (%SST(&USER 01 10) *EQ *DFT) +
CHGVAR VAR(&USER) VALUE('PGMMENU QGPL')
IF (%SST(&USER 11 10) *EQ *USRLIBL) DO
RTVJOBA USRLIBL(&LIBL) /* Get library list. */
CHGVAR VAR(%SST(&USER 11 10)) VALUE(%SST(&LIBL 01 10))
/* Replace *USRLIBL with first library in LIBL */
ENDDO
RTVDTAARA DTAARA(%SST(&USER 01 10).%SST(&USER 11 10)) +
RTNVAR(&PGMDFT)
MONMSG MSGID(CPF1015) EXEC(DO)
/* Send "creating" status message. */
SNDPGMMSG MSGID(PGM1500) MSGF(PGMMSGF) MSGDTA(&USER) +
TOPGMQ(*EXT) MSGTYPE(*STATUS)
CRTDTAARA DTAARA(%SST(&USER 01 10).%SST(&USER 11 10)) +
TYPE(*CHAR) LEN(2000) TEXT('CRC - +
Programmer menu defaults for user:' *CAT +
%SST(&USER 01 10))
CHGVAR VAR(&NEW) VALUE('1') /* Flag for new user */
CHGVAR VAR(&CF01) VALUE('1')
ENDDO
CRTDTAARA DTAARA(PGMDFT.QTEMP) TYPE(*CHAR) LEN(2000) +
VALUE(&PGMDFT) PUBAUT(*ALL)
MONMSG MSGID(CPF0000)
CHGDTAARA DTAARA(PGMDFT.QTEMP) VALUE(&PGMDFT)
MONMSG MSGID(CPF0000)
CALL PGM(CRC1235) PARM(&USER &CF01 &MSGID &MSG)
IF COND(&MSGID *NE ' ') THEN(DO)
SNDPGMMSG MSG(&MSG) TOPGMQ(*PRV) MSGTYPE(*DIAG)
SNDPGMMSG MSG('User''s data area not modified') +
TOPGMQ(*PRV) MSGTYPE(*COMP)
GOTO ENDPGM
ENDDO
IF (&CF01) DO
IF (&NEW) DO
DLTDTAARA DTAARA(%SST(&USER 01 10).%SST(&USER 11 10))
MONMSG MSGID(CPF0000)
ENDDO
/* If new DTAARA, remove it. */
ENDDO
ELSE DO
RTVDTAARA DTAARA(PGMDFT) RTNVAR(&PGMDFT)
MONMSG MSGID(CPF0000)
CHGDTAARA DTAARA(%SST(&USER 01 10).%SST(&USER 11 10)) +
VALUE(&PGMDFT)
MONMSG MSGID(CPF0000)
DLTDTAARA DTAARA(PGMDFT)
MONMSG MSGID(CPF0000)
GOTO ENDPGM
ENDDO
DLTDTAARA DTAARA(PGMDFT)
MONMSG MSGID(CPF0000)
RCVMSG: /* Receive and forward program messages. */
IF (&MSGCNT *LE &MAXMSG) DO
CHGVAR VAR(&MSGCNT) VALUE(&MSGCNT + 1)
RCVMSG RMV(*YES) MSGDTA(&MSGDTA) MSGID(&MSGID)
MONMSG MSGID(CPF0000) EXEC(GOTO ENDPGM)
IF (&MSGID *EQ ' ') GOTO ENDPGM
IF (%SST(&MSGID 1 2) *EQ 'CP' +
*OR %SST(&MSGID 1 3) *EQ 'MCH') DO
IF (&MSGDTA *EQ ' ') SNDPGMMSG MSGID(&MSGID) +
MSGF(QCPFMSG) TOPGMQ(*PRV) MSGTYPE(*DIAG)
ELSE SNDPGMMSG MSGID(&MSGID) MSGF(QCPFMSG) +
MSGDTA(&MSGDTA) TOPGMQ(*PRV) MSGTYPE(*DIAG)
ENDDO
GOTO RCVMSG
ENDDO
ENDPGM: ENDPGM